io Programmo 53/IOPROG_53.ISO/soft/c++/xceedftp.exe/Samples/Visual Basic/FTPClient/clsLocalPaths.cls

Visual Basic class definition | 2000-10-05 | 5.7 KB | 177 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsLocalPaths"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Xceed FTP Library - FTP Client sample application
' Copyright (c) 2000 Xceed Software Inc.
'
' [clsLocalPaths.cls]
'
' This class module contains code for local file/folder/drive listings and operations.
'
' This file is part of the Xceed FTP Library sample applications. The source
' code in this file is only intended as a supplement to Xceed FTP Library's
' documentation, and is provided "as is", without warranty of any kind,
' either expressed or implied.

Option Explicit

' Import a WIN32 API function we need

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

' This class triggers the following 3 events to whoever instantiates it. So,
' when instantiating this class, use "Dim WithEvents <INSTANCENAME> as clsLocalPaths"

Event UpdateLocalEntry(ByVal sName As String, ByVal dtDate As Date, ByVal lSize As Long, ByVal nAttrib As Integer)
Event AddToLocalPaths(ByVal sPathToAdd As String)
Event LogicalDriveFound(ByVal sDriveToAdd As String)

' Constants

Const MsgBoxTitle = "FTP Client sample application "

' ****************************************************************************
' The following procedure will read the contents of the selected drive or
' folder. If the selected path is a file, the file's information will be also
' retrieved.
' ****************************************************************************

Public Sub RetrieveLocalFolderContents(ByVal sPath As String)
  Dim sName As String
  Dim dtDate As Date
  Dim lSize As Long
  Dim nAttrib As Integer

  On Error GoTo LocalError

  sName = Dir(sPath & "*", vbNormal + vbArchive + vbDirectory + vbHidden + vbReadOnly + vbSystem)

  Do While (sName <> "")

    If (sName <> ".") And (sName <> "..") Then  ' Remove the "." and ".." files
      nAttrib = GetAttr(sPath & sName)          ' Retrieve the attributes
      dtDate = FileDateTime(sPath & sName)      ' Retrieve the date
      lSize = (FileLen(sPath & sName))          ' Retrieve the size

      ' Send the information to our main form through an event

      RaiseEvent UpdateLocalEntry(sName, dtDate, lSize, nAttrib)
    End If

    sName = Dir
  Loop

  RaiseEvent AddToLocalPaths(sPath)
  Exit Sub

LocalError:

  Select Case Err.Number

  ' This error occurs if the attributes could not be retreived. Ex : Pagefile.sys
  ' If this is the case, we will set the attribute to -1

  Case 5
    nAttrib = -1
    Resume Next
  Case Else
    Call MsgBox("Cannot read the contents of " & sPath, vbOKOnly + vbCritical, MsgBoxTitle & "[Error]")
    Exit Sub
  End Select

End Sub

' ****************************************************************************
' Retrieve the logical drive names
' ****************************************************************************

Public Sub RetreiveLogicalDrives()
  Dim sDrives As String * 260
  Dim nFirstPos As Integer
  Dim nLastPos As Integer

  On Error Resume Next

  'This function will retreive all the logical drive names
  Call GetLogicalDriveStrings(260, sDrives)

  nFirstPos = 1

  'Since this functions returns only one string with all the drives letters one
  'after the other, we will need to parse the string.
  Do While Mid(sDrives, nFirstPos, 1) <> Chr(0)
    nLastPos = nFirstPos
    Do While Mid(sDrives, nLastPos, 1) <> Chr(0)
      nLastPos = nLastPos + 1
    Loop

    'Send the information to our main form
    RaiseEvent LogicalDriveFound(Mid(sDrives, nFirstPos, nLastPos - nFirstPos))
    nFirstPos = nLastPos + 1
  Loop
End Sub

' ****************************************************************************
' Delete the selected local file(s)
' ****************************************************************************

Public Sub DeleteLocalFile(ByVal sFileToDelete As String)

  On Error Resume Next

  Call Kill(sFileToDelete) ' Delete the file

  If Err.Number <> 0 Then
    MsgBox "Cannot delete " & sFileToDelete, vbOK + vbCritical, MsgBoxTitle & "[Notice]"
  End If
End Sub

' ****************************************************************************
' Rename the selected local file
' ****************************************************************************

Public Sub RenameLocalFile(ByVal sCurrentName As String, ByVal sNewName As String)
  On Error Resume Next

  Name sCurrentName As sNewName

  If Err.Number <> 0 Then
    MsgBox "Cannot rename " & sCurrentName, vbOK + vbCritical, MsgBoxTitle & "[Notice]"
  End If
End Sub

' ****************************************************************************
' Remove the selected local folder
' ****************************************************************************

Public Sub RemoveLocalFolder(ByVal sFolderToDelete As String)
  On Error Resume Next

  Call RmDir(sFolderToDelete)

  If Err.Number <> 0 Then
    MsgBox "Cannot remove " & sFolderToDelete, vbOK + vbCritical, MsgBoxTitle & "[Notice]"
  End If
End Sub

' ****************************************************************************
' Create a new local folder
' ****************************************************************************

Public Sub CreateLocalFolder(ByVal sFolderToCreate As String)
  On Error Resume Next

  Call MkDir(sFolderToCreate)

  If Err.Number <> 0 Then
    MsgBox "Cannot create " & sFolderToCreate, vbOK + vbCritical, MsgBoxTitle & "[Notice]"
  End If
End Sub